Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/mmatch/mainmem3.frm

Visual Basic Form | 1995-09-06 | 12.6 KB | 417 lines

VERSION 2.00
Begin Form BOARD
   BackColor       =   &H00808080&
   Caption         =   "Memory Match"
   ClientHeight    =   5835
   ClientLeft      =   1245
   ClientTop       =   2145
   ClientWidth     =   9855
   Height          =   6525
   Icon            =   MAINMEM3.FRX:0000
   Left            =   1185
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   5835
   ScaleWidth      =   9855
   Top             =   1515
   Width           =   9975
   Begin PictureBox MhButton2
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   8
      Top             =   0
      Width           =   1000
   End
   Begin PictureBox Mh3d1
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   5
      Top             =   0
      Width           =   1000
      Begin PictureBox NUMMATCH
         BackColor       =   &H000000FF&
         Height          =   1000
         Left            =   0
         ScaleHeight     =   975
         ScaleWidth      =   975
         TabIndex        =   7
         Top             =   0
         Width           =   1000
      End
      Begin PictureBox Mh3d4
         BackColor       =   &H000000FF&
         Height          =   1000
         Left            =   0
         ScaleHeight     =   975
         ScaleWidth      =   975
         TabIndex        =   6
         Top             =   0
         Width           =   1000
      End
   End
   Begin PictureBox Mh3d2
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   1
      Top             =   0
      Width           =   1000
      Begin PictureBox NUMTRIES
         BackColor       =   &H000000FF&
         Height          =   1000
         Left            =   0
         ScaleHeight     =   975
         ScaleWidth      =   975
         TabIndex        =   4
         Top             =   0
         Width           =   1000
      End
      Begin PictureBox Mh3d3
         BackColor       =   &H000000FF&
         Height          =   1000
         Left            =   0
         ScaleHeight     =   975
         ScaleWidth      =   975
         TabIndex        =   3
         Top             =   0
         Width           =   1000
      End
   End
   Begin PictureBox PLAYFIELD
      BackColor       =   &H000000FF&
      Height          =   1000
      Left            =   0
      ScaleHeight     =   975
      ScaleWidth      =   975
      TabIndex        =   0
      Top             =   0
      Width           =   1000
      Begin PictureBox MEMORY
         AutoSize        =   -1  'True
         BorderStyle     =   0  'None
         Height          =   480
         Index           =   1
         Left            =   600
         Picture         =   MAINMEM3.FRX:0302
         ScaleHeight     =   480
         ScaleWidth      =   480
         TabIndex        =   2
         Top             =   720
         Visible         =   0   'False
         Width           =   480
      End
   End
   Begin Menu GAMES
      Caption         =   "&Games"
      Begin Menu JOKE
         Caption         =   "2 X 2  (2 matches)"
      End
      Begin Menu GAME
         Caption         =   "3 X 4  (6 matches)"
         Index           =   1
      End
      Begin Menu GAME
         Caption         =   "4 X 4  (8 matches)"
         Index           =   2
      End
      Begin Menu GAME
         Caption         =   "4 X 5  (10 matches)"
         Index           =   3
      End
      Begin Menu GAME
         Caption         =   "4 X 6  (12 matches)"
         Index           =   4
      End
      Begin Menu GAME
         Caption         =   "5 X 6  (15 matches)"
         Index           =   5
      End
      Begin Menu GAME
         Caption         =   "6 X 6  (18 matches)"
         Index           =   6
      End
      Begin Menu GAME
         Caption         =   "6 X 7  (21 matches)"
         Index           =   7
      End
      Begin Menu GAME
         Caption         =   "6 X 8  (24 matches)"
         Index           =   8
      End
      Begin Menu Z
         Caption         =   "-"
      End
      Begin Menu QUIT
         Caption         =   "E&xit"
      End
   End
   Begin Menu OPTIONS
      Caption         =   "&Options"
      Begin Menu ICONS
         Caption         =   "&Flags of the World"
         Checked         =   -1  'True
         Index           =   1
      End
      Begin Menu ICONS
         Caption         =   "&Numbers"
         Index           =   2
      End
   End
   Begin Menu Information
      Caption         =   "&Information"
      Begin Menu HISCORE
         Caption         =   "&High scores"
      End
      Begin Menu ZZ
         Caption         =   "-"
      End
      Begin Menu Info
         Caption         =   "&About"
      End
   End
Sub ABOUT_Click ()
End Sub
Sub Form_Load ()
    Call SETUP
End Sub
Sub GAME_Click (INDEX As Integer)
    CR$ = Chr$(13) + Chr$(10)
    If TRIES > 0 And NUMFLAGS / 2 <> MATCHES Then
        EVAL = MsgBox("Do you want to abandon" + CR$ + "the current game?", 32 + 4, "New game?")
    End If
    If EVAL = 7 Then Exit Sub
    PLAYFIELD.VISIBLE = 0
    Call ICONRESET
    TOPREF = MEMORY(1).TOP
    LEFTREF = MEMORY(1).LEFT
    GAMEBOARD = INDEX
    Select Case INDEX
        Case 1
            NUMFLAGS = 12       '3 X 4
            ROWS = 3
        Case 2
            NUMFLAGS = 16       '4 X 4
            ROWS = 4
        Case 3
            NUMFLAGS = 20       '4 X 5
            ROWS = 4
        Case 4
            NUMFLAGS = 24       '4 X 6
            ROWS = 4
        Case 5
            NUMFLAGS = 30       '5 x 6
            ROWS = 5
        Case 6
            NUMFLAGS = 36       '6 X 6
            ROWS = 6
        Case 7
            NUMFLAGS = 42       '6 X 7
            ROWS = 6
        Case 8
            NUMFLAGS = 48       '6 X 8
            ROWS = 6
    End Select
    For I = 1 To NUMFLAGS

        If I > ROWS And I Mod ROWS = 1 Then
            LEFTREF = LEFTREF + 700
            TOPREF = MEMORY(1).TOP
        End If

        If I <> 1 Then
            If I Mod ROWS <> 1 Then
                TOPREF = TOPREF + 700
            End If
            Load MEMORY(I)
            MEMORY(I).TOP = TOPREF
            MEMORY(I).LEFT = LEFTREF
        End If

        MEMORY(I).VISIBLE = -1

    Next
    PLAYFIELD.HEIGHT = MEMORY(NUMFLAGS).TOP + MEMORY(NUMFLAGS).HEIGHT + 600
    PLAYFIELD.WIDTH = MEMORY(NUMFLAGS).LEFT + MEMORY(NUMFLAGS).WIDTH + 600
    PLAYFIELD.VISIBLE = -1
    Call SETUP
End Sub
Sub HISCORE_Click ()
    SCORES.Show 1
End Sub
Sub ICONRESET ()
    If NUMFLAGS Then
        NUMTRIES.CAPTION = "0"
        MEMORY(1).VISIBLE = 0
        MEMORY(1).PICTURE = LoadPicture(ICONDIR$ + "FACE03.ICO")
        For I = 2 To NUMFLAGS
            Unload MEMORY(I)
        Next
    End If
End Sub
Sub ICONS_Click (INDEX As Integer)
    For I = 1 To 2
        ICONS(I).CHECKED = 0
    Next
    ICONS(INDEX).CHECKED = -1
End Sub
Sub INFO_Click ()
    ABOUT.Show 1
End Sub
Sub JOKE_Click ()
    MsgBox "You must be joking.....", 48, "    2 X 2    "
End Sub
Static Sub MEMORY_Click (INDEX As Integer)
    CR$ = Chr$(13) + Chr$(10)
    If CARD$(INDEX) = "PICKED" Then
        Beep
        Exit Sub
    End If
    If BUTTON1 And INDEX = BUTTON1 Then
        Beep: Beep
        Exit Sub
    End If
    PICKED = PICKED + 1

    If PICKED = 1 Then
        MEMORY(INDEX).PICTURE = LoadPicture(CARD$(INDEX))
        MATCH1$ = CARD$(INDEX)
        BUTTON1 = INDEX
    Else
        MEMORY(INDEX).PICTURE = LoadPicture(CARD$(INDEX))
        MATCH2$ = CARD$(INDEX)
        BUTTON2 = INDEX
    End If
    If PICKED = 2 Then
        PICKED = 0
        TRIES = TRIES + 1
        NUMTRIES.CAPTION = Str$(TRIES)
        If MATCH1$ <> MATCH2$ Then

            X = Timer
            While X + 2 > Timer: Wend
            MEMORY(BUTTON1).PICTURE = LoadPicture(UPBUTTON$)
            MEMORY(BUTTON2).PICTURE = LoadPicture(UPBUTTON$)

            BUTTON1 = 0
            BUTTON2 = 0
        Else
            CARD$(BUTTON1) = "PICKED"
            CARD$(BUTTON2) = "PICKED"
            MATCHES = MATCHES + 1
            NUMMATCH.CAPTION = Str$(MATCHES) + " of" + Str$(NUMFLAGS / 2)
            If MATCHES = NUMFLAGS / 2 Then

                Open "MMWINNER.FIL" For Random As #1 Len = Len(SCORE)
                    Get #1, GAMEBOARD, SCORE
                    If SCORE.POINTS = 0 Or TRIES <= SCORE.POINTS Then
                        If TRIES = SCORE.POINTS Then
                            TEXT$ = "You have tied "
                        Else
                            TEXT$ = "You have beaten "
                        End If
                        TEXT$ = TEXT$ + "the high score for this game..." + CR$ + "                   Congratulations !!!"
                        MsgBox TEXT$, 64, "New High Score"
                        SCORE.POINTS = TRIES
                        HSENTRY.Show 1
                        Put #1, GAMEBOARD, SCORE
                    End If
                Close
            End If
        End If
    End If
End Sub
Sub MhButton2_Click ()
    End
End Sub
Sub QUIT_Click ()
    End
End Sub
Sub SETUP ()
    PICKED = 0
    ICONDIR$ = CurDir$ + "\"
    UPBUTTON$ = ICONDIR$ + "FACE03.ICO"
    For I = 1 To 2
        If ICONS(I).CHECKED = -1 Then OPT = I
    Next
    Select Case ICONS(OPT).INDEX
        Case Is = 1
            A$(1) = ICONDIR$ + "FLGASTRL.ICO"
            A$(2) = ICONDIR$ + "FLGAUSTA.ICO"
            A$(3) = ICONDIR$ + "FLGBRAZL.ICO"
            A$(4) = ICONDIR$ + "FLGCAN.ICO"
            A$(5) = ICONDIR$ + "FLGDEN.ICO"
            A$(6) = ICONDIR$ + "FLGFIN.ICO"
            A$(7) = ICONDIR$ + "FLGFRAN.ICO"
            A$(8) = ICONDIR$ + "FLGGERM.ICO"
            A$(9) = ICONDIR$ + "FLGIREL.ICO"
            A$(10) = ICONDIR$ + "FLGITALY.ICO"
            A$(11) = ICONDIR$ + "FLGJAPAN.ICO"
            A$(12) = ICONDIR$ + "FLGMEX.ICO"
            A$(13) = ICONDIR$ + "FLGNETH.ICO"
            A$(14) = ICONDIR$ + "FLGNORW.ICO"
            A$(15) = ICONDIR$ + "FLGNZ.ICO"
            A$(16) = ICONDIR$ + "FLGPORT.ICO"
            A$(17) = ICONDIR$ + "FLGSPAIN.ICO"
            A$(18) = ICONDIR$ + "FLGSWED.ICO"
            A$(19) = ICONDIR$ + "FLGSWITZ.ICO"
            A$(20) = ICONDIR$ + "FLGTURK.ICO"
            A$(21) = ICONDIR$ + "FLGUK.ICO"
            A$(22) = ICONDIR$ + "FLGUSA01.ICO"
            A$(23) = ICONDIR$ + "FLGUSA02.ICO"
            A$(24) = ICONDIR$ + "FLGUSSR.ICO"
        Case Is = 2
            A$(1) = ICONDIR$ + "1.ICO"
            A$(2) = ICONDIR$ + "2.ICO"
            A$(3) = ICONDIR$ + "3.ICO"
            A$(4) = ICONDIR$ + "4.ICO"
            A$(5) = ICONDIR$ + "5.ICO"
            A$(6) = ICONDIR$ + "6.ICO"
            A$(7) = ICONDIR$ + "7.ICO"
            A$(8) = ICONDIR$ + "8.ICO"
            A$(9) = ICONDIR$ + "9.ICO"
            A$(10) = ICONDIR$ + "10.ICO"
            A$(11) = ICONDIR$ + "11.ICO"
            A$(12) = ICONDIR$ + "12.ICO"
            A$(13) = ICONDIR$ + "13.ICO"
            A$(14) = ICONDIR$ + "14.ICO"
            A$(15) = ICONDIR$ + "15.ICO"
            A$(16) = ICONDIR$ + "16.ICO"
            A$(17) = ICONDIR$ + "17.ICO"
            A$(18) = ICONDIR$ + "18.ICO"
            A$(19) = ICONDIR$ + "19.ICO"
            A$(20) = ICONDIR$ + "20.ICO"
            A$(21) = ICONDIR$ + "21.ICO"
            A$(22) = ICONDIR$ + "22.ICO"
            A$(23) = ICONDIR$ + "23.ICO"
            A$(24) = ICONDIR$ + "24.ICO"
    End Select
    Randomize Timer
    MATCHES = 0
    TRIES = 0
    For I = 1 To NUMFLAGS
        CARD$(I) = ""
    Next
    For I = 1 To NUMFLAGS

        OK = 0
        Do
            NUM = Int(NUMFLAGS * Rnd(1) + 1)
            If CARD$(NUM) = "" Then
                X = Int(I * .5 + .5)
                CARD$(NUM) = A$(X)
                OK = 1
            End If

        Loop Until OK
    Next
    NUMMATCH.CAPTION = "0 of" + Str$(NUMFLAGS / 2)
End Sub